home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tcpech1a / clsscree.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-08-31  |  18.5 KB  |  582 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsScreen"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. 'Constants
  17. Const MyModule = "clsScreen"
  18.  
  19. 'Hooked Variables - for every one you add, add it to class_terminate as well
  20. Public WithEvents mForm As Form
  21. Attribute mForm.VB_VarHelpID = -1
  22. Private WithEvents mToolbar As Toolbar
  23. Attribute mToolbar.VB_VarHelpID = -1
  24. Private mStatusBar As StatusBar
  25. Attribute mStatusBar.VB_VarHelpID = -1
  26. Private WithEvents mLstPlayers As ListBox
  27. Attribute mLstPlayers.VB_VarHelpID = -1
  28. Private WithEvents mLstGMs As ListBox
  29. Attribute mLstGMs.VB_VarHelpID = -1
  30. Private WithEvents mPicLights As PictureBox
  31. Attribute mPicLights.VB_VarHelpID = -1
  32. Private WithEvents mTxtInput As TextBox
  33. Attribute mTxtInput.VB_VarHelpID = -1
  34.  
  35. Friend Sub Init()
  36. '------------------------------------------------------------
  37. 'Initialize the screen settings
  38. '------------------------------------------------------------
  39.     Const MyError = MyModule & "_" & "Init"
  40.     If Timings Then PerformanceStartTime MyError
  41.     On Error GoTo Err_Init
  42.  
  43. '------------------------------------------------------------
  44. 'Hook the form to capture its events
  45. '------------------------------------------------------------
  46.     Load frmServer
  47.     Set mForm = frmServer
  48.     mForm_Load
  49.     'mForm.ControlBox = False
  50.     
  51. '------------------------------------------------------------
  52. 'Initialize the toolbar
  53. '------------------------------------------------------------
  54.  
  55.     Set mToolbar = mForm.Toolbar1
  56.     mToolbar.ImageList = mForm.imgListToolbar
  57.     mToolbar.Appearance = ccFlat
  58.     mToolbar.Wrappable = True
  59.     mToolbar.AllowCustomize = False
  60.     mToolbar.RestoreToolbar "Incarnation Server", "Settings", "mToolbar"
  61.    
  62.     With mToolbar.Buttons
  63.         .Add , "Upload", "Upload Client", , "Upload"
  64.         .Add , "Record", "Record", , "Microphone"
  65.         .Add , "PlaySound", "Play", , "Sound"
  66.         .Add , "Time", "Time", , "Time"
  67.         .Add , "Weather", "Weather", , "Sun"
  68.         .Add , "Sessions", "Sessions", , "Sessions"
  69.         .Add , "Timings", "Timings", , "Timings"
  70.         .Add , "Monsters", "Spawning", , "Hamster"
  71.         .Add , "Warning", "Warning", , "Warning"
  72.         .Add , "Quit", "Shutdown", , "Stop"
  73.     End With
  74.         
  75.     'Set up sub-buttons.
  76.     With mToolbar.Buttons(3)
  77.         .Style = tbrDropdown
  78.         .ButtonMenus.Add , "Recorded", "Recorded Message"
  79.         .ButtonMenus.Add , "Midi1", "Midi 1"
  80.         .ButtonMenus.Add , "Welcome", "Welcome"
  81.     End With
  82.     
  83.     With mToolbar.Buttons(4)
  84.         .Style = tbrDropdown
  85.         .ButtonMenus.Add , , "Midnight"
  86.         .ButtonMenus.Add , , "01:00 AM"
  87.         .ButtonMenus.Add , , "02:00 AM"
  88.         .ButtonMenus.Add , , "03:00 AM"
  89.         .ButtonMenus.Add , , "04:00 AM"
  90.         .ButtonMenus.Add , , "05:00 AM"
  91.         .ButtonMenus.Add , , "06:00 AM"
  92.         .ButtonMenus.Add , , "07:00 AM"
  93.         .ButtonMenus.Add , , "08:00 AM"
  94.         .ButtonMenus.Add , , "09:00 AM"
  95.         .ButtonMenus.Add , , "10:00 AM"
  96.         .ButtonMenus.Add , , "12:00 AM"
  97.         .ButtonMenus.Add , , "Noon"
  98.         .ButtonMenus.Add , , "01:00 PM"
  99.         .ButtonMenus.Add , , "02:00 PM"
  100.         .ButtonMenus.Add , , "03:00 PM"
  101.         .ButtonMenus.Add , , "04:00 PM"
  102.         .ButtonMenus.Add , , "05:00 PM"
  103.         .ButtonMenus.Add , , "06:00 PM"
  104.         .ButtonMenus.Add , , "07:00 PM"
  105.         .ButtonMenus.Add , , "08:00 PM"
  106.         .ButtonMenus.Add , , "09:00 PM"
  107.         .ButtonMenus.Add , , "10:00 PM"
  108.         .ButtonMenus.Add , , "11:00 PM"
  109.     End With
  110.     
  111.     With mToolbar.Buttons(5)
  112.         .Style = tbrDropdown
  113.         .ButtonMenus.Add , "Sun", "Sun"
  114.         .ButtonMenus.Add , "Rain", "Rain"
  115.         .ButtonMenus.Add , "Snow", "Snow"
  116.     End With
  117.     
  118.     With mToolbar.Buttons(7)
  119.         .Style = tbrDropdown
  120.         .ButtonMenus.Add , "Display", "Display To Screen"
  121.         .ButtonMenus.Add , "File", "Write To File"
  122.         .ButtonMenus.Add , , "-"
  123.         .ButtonMenus.Add , "TurnOn", "Turn On Timings"
  124.         .ButtonMenus.Add , "TurnOff", "Turn Off Timings"
  125.     End With
  126.     
  127. '------------------------------------------------------------
  128. 'Initialize the status bar
  129. '------------------------------------------------------------
  130.     Set mStatusBar = mForm.StatusBar1
  131.     With mStatusBar
  132.         .Panels.Clear
  133.         .Panels.Add , "pnl1"
  134.         .Panels.Add , "pnl2"
  135.         .Panels.Add , "pnlTime"
  136.         Time = G.CurrentTime
  137.     End With
  138.  
  139. '------------------------------------------------------------
  140. 'Initialize the player list
  141. '------------------------------------------------------------
  142.     Set mLstPlayers = mForm.lstPlayers
  143.     Set mLstGMs = mForm.lstGMs
  144.     mLstPlayers.Visible = True
  145.     mLstGMs.Visible = False
  146.     
  147. '------------------------------------------------------------
  148. 'Initialize the flashing lights
  149. '------------------------------------------------------------
  150.     Set mPicLights = mForm.picLights
  151.     mPicLights.Width = 505
  152.     mPicLights.Height = 100
  153.     'mPicLights.DrawWidth = 4
  154.     mPicLights.FillStyle = 0
  155.  
  156. '------------------------------------------------------------
  157. 'Rearrange the controls on the form
  158. '------------------------------------------------------------
  159.     mForm_Resize
  160.  
  161. '------------------------------------------------------------
  162. 'Initialize the input box
  163. '------------------------------------------------------------
  164.     Set mTxtInput = mForm.txtInput
  165.     
  166. '------------------------------------------------------------
  167. 'Show the form
  168. '------------------------------------------------------------
  169.     mForm.Visible = True
  170.  
  171. '------------------------------------------------------------
  172. 'End of procedure
  173. '------------------------------------------------------------
  174.     If Timings Then PerformanceEndTime MyError
  175.     Exit Sub
  176.     
  177. Err_Init:
  178.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  179.     Resume Next
  180. End Sub
  181.  
  182. Friend Property Let DebugText(ByVal s As String)
  183. '------------------------------------------------------------
  184. 'Writes text to the server debug display
  185. '------------------------------------------------------------
  186.  
  187.     Dim chars As Long
  188.     Const MyError = MyModule & "_" & "DebugText"
  189.     If Timings Then PerformanceStartTime MyError
  190.  
  191.     On Error GoTo Err_Init
  192.     
  193.     If Right$(s, 2) = vbCrLf Then
  194.         'skip it
  195.     Else
  196.         s = s & vbCrLf
  197.     End If
  198.     
  199.     'Update server debug display
  200.     With mForm.txtDebug
  201.         chars = Len(.Text)
  202.         If chars > 15000 Then
  203.             .Text = Right(.Text, 1000)
  204.             chars = Len(.Text)
  205.         End If
  206.         If Len(s) > 15000 Then
  207.             s = Right(s, 15000)
  208.         End If
  209.         .SelStart = chars
  210.         .SelText = Format(Now) & " " & s
  211.         .SelStart = Len(.Text)
  212.     End With
  213.     
  214.     If Timings Then PerformanceEndTime MyError
  215.     Exit Property
  216.     
  217. Err_Init:
  218.     Debug.Print Err.Number & " - " & Err.Description
  219.     Resume Next
  220. End Property
  221.  
  222. Friend Property Let OutputText(ByVal s As String)
  223. '------------------------------------------------------------
  224. 'Writes text to the server output display
  225. '------------------------------------------------------------
  226.  
  227.     Dim chars As Long
  228.     Const MyError = MyModule & "_" & "OutputText"
  229.     If Timings Then PerformanceStartTime MyError
  230.  
  231.     On Error GoTo Err_Init
  232.     
  233.     If Right$(s, 2) = vbCrLf Then
  234.         'skip it
  235.     Else
  236.         s = s & vbCrLf
  237.     End If
  238.     
  239.     'Update server debug display
  240.     With mForm.txtOutput
  241.         chars = Len(.Text)
  242.         If chars > 100000 Then
  243.             .Text = ""
  244.             chars = 0
  245.             '.Text = Right(.Text, 1000)
  246.             'chars = Len(.Text)
  247.         End If
  248.         If Len(s) > 80000 Then
  249.             s = Right(s, 80000)
  250.         End If
  251.         .SelStart = chars
  252.         .SelText = Format(Now) & " " & s
  253.         .SelStart = Len(.Text)
  254.     End With
  255.     
  256.     If Timings Then PerformanceEndTime MyError
  257.     Exit Property
  258.     
  259. Err_Init:
  260.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  261.     Resume Next
  262. End Property
  263.  
  264. Friend Property Let Time(ByVal t As Date)
  265. '------------------------------------------------------------
  266. 'Updates the date/time display
  267. '------------------------------------------------------------
  268.  
  269.     Const MyError = MyModule & "_" & "Time"
  270.     If Timings Then PerformanceStartTime MyError
  271.  
  272.     On Error GoTo Err_Init
  273.     
  274.     mStatusBar.Panels("pnlTime").Text = Format(t, "HH:MM AMPM")
  275.         
  276.     If Timings Then PerformanceEndTime MyError
  277.     Exit Property
  278.     
  279. Err_Init:
  280.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  281.     Resume Next
  282. End Property
  283.  
  284. Private Sub Class_Terminate()
  285. '------------------------------------------------------------
  286. 'Shuts down the screen class
  287. '------------------------------------------------------------
  288.  
  289. 'Release all hooked variables
  290.     Unload mForm
  291.     Set mForm = Nothing
  292.     Set mToolbar = Nothing
  293.     Set mStatusBar = Nothing
  294.     Set mLstPlayers = Nothing
  295.     Set mLstGMs = Nothing
  296.     Set mPicLights = Nothing
  297.     Set mTxtInput = Nothing
  298. End Sub
  299.  
  300. Private Sub mForm_Load()
  301. '------------------------------------------------------------
  302. 'Set up tcp callback
  303. '------------------------------------------------------------
  304.     TCP.StartCallback
  305. End Sub
  306.  
  307. Private Sub mForm_Unload(Cancel As Integer)
  308. '------------------------------------------------------------
  309. 'Make sure they quit from the 'shutdown' button only, and
  310. 'if so, disconnect the TCP callbacks
  311. '------------------------------------------------------------
  312.     If QuitGame = False Then
  313.         'don't let them click the x!
  314.         MsgBox "Please quit by clicking the 'shutdown' button"
  315.         Cancel = 1
  316.     Else
  317.         TCP.StopCallback
  318.     End If
  319. End Sub
  320.  
  321. Private Sub mForm_Resize()
  322. '------------------------------------------------------------
  323. 'Resize all controls on form
  324. '------------------------------------------------------------
  325.     Dim NewHeight As Long
  326.     Dim NewWidth As Long
  327.     Dim HeightLeft As Long
  328.     Dim WidthLeft As Long
  329.     Dim ToolbarHeight As Long
  330.     Const MyError = MyModule & "_" & "mForm_Resize"
  331.     If Timings Then PerformanceStartTime MyError
  332.     On Error GoTo Err_Init
  333.     
  334.     'Display the current width/height
  335.     mStatusBar.Panels("pnl2").Text = mForm.ScaleWidth & "x" & mForm.ScaleHeight
  336.     
  337.     'Set the minimum height/width of the form
  338.     NewHeight = mForm.ScaleHeight
  339.     NewWidth = mForm.ScaleWidth
  340.     If NewWidth < 400 Then
  341.         mForm.Width = 6120
  342.         Exit Sub
  343.     End If
  344.     If NewHeight < 350 Then
  345.         mForm.Height = 5655
  346.         Exit Sub
  347.     End If
  348.     
  349.     'Figure out the toolbar height
  350.     If NewWidth < 752 Then
  351.         ToolbarHeight = 108
  352.     Else
  353.         ToolbarHeight = 56
  354.     End If
  355.     
  356.     'Size the flashing lights
  357.     With mPicLights
  358.         .Top = ToolbarHeight
  359.         .Left = 0
  360.     End With
  361.     
  362.     'Calculate what's left
  363.     HeightLeft = NewHeight - (mPicLights.Top + mPicLights.Height) - (mForm.txtInput.Height) - (mForm.StatusBar1.Height)
  364.     WidthLeft = NewWidth - mPicLights.Width
  365.     
  366.     'Set the player and gm limStatusBarox colors
  367.     mLstPlayers.BackColor = vbBlack
  368.     mLstGMs.BackColor = vbBlack
  369.     mLstPlayers.ForeColor = &HFFC0C0
  370.     mLstGMs.ForeColor = &H1080F0
  371.     'Set the player and gm top and height
  372.     mLstPlayers.Top = ToolbarHeight
  373.     mLstGMs.Top = ToolbarHeight
  374.     mLstPlayers.Height = mPicLights.Height
  375.     mLstGMs.Height = mPicLights.Height
  376.     If WidthLeft > 140 Then
  377.         'display player and gm list
  378.         mLstGMs.Visible = True
  379.         mLstPlayers.Width = WidthLeft / 2
  380.         mLstPlayers.Left = mPicLights.Width
  381.         mLstGMs.Width = NewWidth - (mLstPlayers.Left + mLstPlayers.Width)
  382.         mLstGMs.Left = mLstPlayers.Left + mLstPlayers.Width
  383.     ElseIf WidthLeft > 0 Then
  384.         'display player list only
  385.         mLstGMs.Visible = False
  386.         mLstPlayers.Width = WidthLeft
  387.         mLstPlayers.Left = mPicLights.Width
  388.     Else
  389.         'don't even bother.
  390.     End If
  391.     
  392.     'Size the debug textbox
  393.     With mForm.txtDebug
  394.         .BackColor = vbBlack
  395.         .Height = HeightLeft * 0.2
  396.         .Top = mPicLights.Top + mPicLights.Height
  397.         .Left = 0
  398.         .Width = NewWidth
  399.     End With
  400.     
  401.     'Size the input textbox
  402.     With mForm.txtInput
  403.         .BackColor = &HFFFFFF
  404.         .Top = mForm.txtDebug.Top + mForm.txtDebug.Height
  405.         .Left = 0
  406.         .Width = NewWidth
  407.     End With
  408.     
  409.     'Size the output textbox
  410.     With mForm.txtOutput
  411.         .BackColor = &HC0C0C0
  412.         .Height = HeightLeft * 0.8
  413.         .Top = mForm.txtInput.Top + mForm.txtInput.Height
  414.         .Left = 0
  415.         .Width = NewWidth
  416.     End With
  417.     
  418.     'Size the status bar
  419.     With mForm.StatusBar1
  420.         .Panels("pnl2").Width = 70
  421.         .Panels("pnlTime").Width = 70
  422.         .Panels("pnl1").Width = NewWidth - .Panels("pnl2").Width - .Panels("pnlTime").Width
  423.     End With
  424.     
  425.     If Timings Then PerformanceEndTime MyError
  426.     Exit Sub
  427.     
  428. Err_Init:
  429.     If Err.Number = 91 Then
  430.         'the form isn't ready to be sized yet - exit
  431.         Exit Sub
  432.     Else
  433.         CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  434.         Resume Next
  435.     End If
  436. End Sub
  437.  
  438. Private Sub mPicLights_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  439. '------------------------------------------------------------
  440. 'Displays the session the user is currently hovering over
  441. '------------------------------------------------------------
  442.     Dim x1 As Long, y1 As Long
  443.     Dim Index As Long
  444.     Dim Status As Long, s As String
  445.     Const MyError = MyModule & "_" & "mPicLights"
  446.     If Timings Then PerformanceStartTime MyError
  447.     On Error GoTo Err_Init
  448.     
  449.     '500 wide by 100 tall - convert down to 100 wide by 20 tall
  450.     y1 = CInt(Y \ 5) + 1 'use the backwards \ to discard remainder
  451.     x1 = CInt(x \ 5) + 1
  452.     Index = (y1 - 1) * 100 + x1
  453.     Status = Connection(Index).Status
  454.     Select Case Status
  455.         Case ltDisconnected: s = "ltDisconnected"
  456.         Case ltIdle: s = "ltIdle"
  457.         Case ltTCPUnspecifiedWriteError: s = "ltTCPUnspecifiedWriteError"
  458.         Case ltTCPReadError: s = "ltTCPReadError"
  459.         Case ltTCPSendError: s = "ltTCPSendError"
  460.         Case ltTCPSendTextError: s = "ltTCPSendTextError"
  461.         Case ltTCPBlocked: s = "ltTCPBlocked"
  462.     End Select
  463.  
  464.     mPicLights.ToolTipText = "Session " & Index & " " & Connection(Index).Name & " - " & s
  465.     If Timings Then PerformanceEndTime MyError
  466.     Exit Sub
  467.     
  468. Err_Init:
  469.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  470.     Resume Next
  471. End Sub
  472.  
  473. Private Sub mToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  474. '------------------------------------------------------------
  475. 'Process the toolbar button commands
  476. '------------------------------------------------------------
  477.     Dim btn As String
  478.     Const MyError = MyModule & "_" & "mToolbar_ButtonClick"
  479.     If Timings Then PerformanceStartTime MyError
  480.     On Error GoTo Err_Init
  481.     
  482.     btn = LCase(Button.Caption)
  483.     If btn = "time" Then
  484.         'set the server time
  485.         G.CurrentTime = Now
  486.     ElseIf btn = "timings" Then
  487.         'send 'display to screen' mouseclick
  488.         mToolbar_ButtonMenuClick Button.ButtonMenus("Display")
  489.     ElseIf btn = "shutdown" Then
  490.         'shut the program down
  491.         QuitGame = True
  492.         GameShutDown
  493.     Else
  494.         MsgBox Button.Caption
  495.     End If
  496.     
  497.     If Timings Then PerformanceEndTime MyError
  498.     Exit Sub
  499.     
  500. Err_Init:
  501.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  502.     Resume Next
  503. End Sub
  504.  
  505. Private Sub mToolbar_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
  506. '------------------------------------------------------------
  507. 'Process the toolbar menu commands
  508. '------------------------------------------------------------
  509.     Dim Parent As String, Menu As String
  510.     Const MyError = MyModule & "_" & "mToolbar_ButtonMenuClick"
  511.     'If Timings Then PerformanceStartTime MyError
  512.     On Error GoTo Err_Init
  513.     
  514.     Parent = LCase(ButtonMenu.Parent.Caption)
  515.     Menu = LCase(ButtonMenu.Text)
  516.     
  517.     If Parent = "time" Then
  518.         If Menu = "midnight" Then
  519.             G.CurrentTime = CDate("12:00 am")
  520.         ElseIf Menu = "noon" Then
  521.             G.CurrentTime = CDate("12:00 pm")
  522.         Else
  523.             G.CurrentTime = CDate(Menu)
  524.         End If
  525.     ElseIf Parent = "timings" Then
  526.         If Menu = "display to screen" Then
  527.             CScreen.OutputText = Perf.List()
  528.         ElseIf Menu = "turn on timings" Then
  529.             Timings = True
  530.         ElseIf Menu = "turn off timings" Then
  531.             Timings = False
  532.         Else
  533.             MsgBox Parent & " - " & Menu
  534.         End If
  535.     Else
  536.         MsgBox Parent & " - " & Menu
  537.     End If
  538.     
  539.     'If Timings Then PerformanceEndTime MyError
  540.     Exit Sub
  541.     
  542. Err_Init:
  543.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  544.     Resume Next
  545. End Sub
  546.  
  547. Private Sub mTxtInput_KeyPress(KeyAscii As Integer)
  548. '------------------------------------------------------------
  549. 'Send data from the server as 'sysop'
  550. '------------------------------------------------------------
  551.  
  552.     Const MyError = MyModule & "_" & "mTxtInput_KeyPress"
  553.     If Timings Then PerformanceStartTime MyError
  554.     On Error GoTo Err_Init
  555.     Dim StrData As String
  556.     
  557.     If KeyAscii = 13 Then
  558.         StrData = mTxtInput.Text
  559.         mTxtInput.Text = ""
  560.         TCP.SendText StrData, 0
  561.     End If
  562.     
  563.     If Timings Then PerformanceEndTime MyError
  564.     Exit Sub
  565.     
  566. Err_Init:
  567.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  568.     Resume Next
  569. End Sub
  570.  
  571. Friend Property Let Lights(Index As Long, LightState As enumLights)
  572. '------------------------------------------------------------
  573. 'Turns on/off a flashing light.
  574. 'Lights are 100 across by 20 down.
  575. '------------------------------------------------------------
  576.     Dim x As Long, Y As Long
  577.     Y = (CInt((Index - 1) \ 100) + 1) 'use the backwards \ to discard remainder
  578.     x = (Index - ((Y - 1) * 100))
  579.     mPicLights.Line ((x - 1) * 5, (Y - 1) * 5)-(((x - 1) * 5) + 3, ((Y - 1) * 5) + 3), LightState, BF
  580.     mPicLights.Refresh
  581. End Property
  582.